Software 2000/Software 2000 Volume 1 (Disc 1 of 2).iso/utilities/u303.dms/in.adf/Keyboard_Definer.AMOS/Keyboard_Definer.amosSourceCode

AMOS Source Code | 1990-11-07 | 15.7 KB | 607 lines

'   AMOS Keyboard Definer V.1!
'
'       By P.J.Hickman
'
'� Copyright 1990 Mandarin Software
'
'Set up variables
KEY_BUFFER=Areg(4)
WEIGHTING=0
HIGHLIGHTED_KEY=-1
Dim WHERE(95,3)
SEL_ASCII=0
FILE$=""
Close Editor
'Global variables for alert box
Dim LINE$(5),BUTTON$(3)
'Get the fonts
Get Rom Fonts
Set Font 1
'Copy the keyboard layout into a memory bank, just in case the user
'wishes to get the original key board back.
Reserve As Work 6,388
Copy KEY_BUFFER,KEY_BUFFER+388 To Start(6)
'Set up the initial display
SET_UP_SCREEN
SET_UP_ZONES
KEYBOARD_PRINT
DISPLAY_CHAR_VALUE
On Menu Proc MENU_1,MENU_2
Repeat
   Repeat
      On Menu On
      M=Mouse Zone
      C=(Mouse Key=1)
   Until C
   'If the user clicks on the ascii display window, poke it!!
   If M=15 and HIGHLIGHTED_KEY<>-1
      Bell
      Poke KEY_BUFFER+HIGHLIGHTED_KEY+(96*WEIGHTING),SEL_ASCII
      KEY_STICK[HIGHLIGHTED_KEY,1]
      DISPLAY_KEY_INFO[HIGHLIGHTED_KEY]
      Wait 5
   End If
   'This bit controls the ALT part of the keyboard
   If M=72 or M=73
      If WEIGHTING=2
         ALT[0]
         WEIGHTING=0
      Else
         If WEIGHTING=3
            ALT[0]
            WEIGHTING=1
         Else
            If WEIGHTING=0
               WEIGHTING=2
               ALT[1]
            Else
               WEIGHTING=3
               ALT[1]
            End If
         End If
      End If
      KEYBOARD_PRINT
      If HIGHLIGHTED_KEY<>-1
         KEY_STICK[HIGHLIGHTED_KEY,1]
         DISPLAY_KEY_INFO[HIGHLIGHTED_KEY]
      End If
   End If
   'This bit controls the SHIFT/CAPS part of the keyboard
   If M=69 or M=70 or M=66
      If WEIGHTING=1
         SHIFTS[0]
         WEIGHTING=0
      Else
         If WEIGHTING=3
            SHIFTS[0]
            WEIGHTING=2
         Else
            Inc WEIGHTING
            SHIFTS[1]
         End If
      End If
      KEYBOARD_PRINT
      If HIGHLIGHTED_KEY<>-1
         KEY_STICK[HIGHLIGHTED_KEY,1]
         DISPLAY_KEY_INFO[HIGHLIGHTED_KEY]
      End If
   End If
   'This bits do the rest of the keyboard (selectable keys)
   If M<>0 and M<>66 and M<>69 and M<>70 and M<>72 and M<>73 and M<>74 and M<>76 and M<>15 and M<>29 and C and M-1<>HIGHLIGHTED_KEY and M<97
      If HIGHLIGHTED_KEY<>-1
         KEY_STICK[HIGHLIGHTED_KEY,0]
      End If
      KEY_STICK[M-1,1]
      DISPLAY_KEY_INFO[M-1]
      HIGHLIGHTED_KEY=M-1
   End If
   'These lines check the ASCII code selecter arrows
   If M=74
      Add SEL_ASCII,-1,0 To 255
      DISPLAY_CHAR_VALUE
      Wait 5
   End If
   If M=76
      Add SEL_ASCII,1,0 To 255
      DISPLAY_CHAR_VALUE
      Wait 5
   End If
   'Has the input zone been clicked on?
   If M=29
      TEST_KEYBOARD
   End If
   Clear Key
Until False
'The next two procedures activate menu options when selected.
Procedure MENU_1
   Shared LINE$(),BUTTON$()
   If Choice(2)=1
      For LOP=1 To 10
         Bell 50+LOP
         Wait 3
      Next LOP
      LINE$(0)="Keyboard Definer"
      LINE$(1)="~~~~~~~~~~~~~~~~"
      LINE$(2)=""
      LINE$(3)=" By P.J.Hickman"
      BUTTON$(0)="Have Fun!!!"
      ALERT[22,9,7,1,1,4]
   End If
   If Choice(2)=3
      Default
      End
   End If
   On Menu On
End Proc
Procedure MENU_2
   Shared HIGHLIGHTED_KEY
   If Choice(2)=1 Then KEYBOARD_LOAD
   If Choice(2)=2 Then KEYBOARD_SAVE[1]
   If Choice(2)=3 Then KEYBOARD_SAVE[2]
   If Choice(2)=8 Then TEST_KEYBOARD
   If Choice(2)=5 and HIGHLIGHTED_KEY<>-1 Then KEY_RESTORE
   If Choice(2)=6 Then KEYBOARD_RESTORE
   On Menu On
End Proc
'The next two procedures restore the key (or keyboard) to it's original
'state.
Procedure KEY_RESTORE
   Shared WEIGHTING,KEY_BUFFER,HIGHLIGHTED_KEY
   Bell 30
   Poke KEY_BUFFER+HIGHLIGHTED_KEY+(96*WEIGHTING),Peek(Start(6)+HIGHLIGHTED_KEY+(96*WEIGHTING))
   KEY_STICK[HIGHLIGHTED_KEY,1]
   DISPLAY_KEY_INFO[HIGHLIGHTED_KEY]
End Proc
Procedure KEYBOARD_RESTORE
   Shared KEY_BUFFER,LINE$(),BUTTON$(),HIGHLIGHTED_KEY
   LINE$(0)="Are you sure you want to restore the"
   LINE$(1)="keyboard to it's default setting?"
   BUTTON$(0)="Yes please"
   BUTTON$(1)="No thanks!"
   ALERT[40,7,7,1,2,2]
   If Param=1
      Bell 30
      Copy Start(6),Start(6)+388 To KEY_BUFFER
      KEYBOARD_PRINT
      If HIGHLIGHTED_KEY<>-1
         KEY_STICK[HIGHLIGHTED_KEY,1]
      End If
   End If
End Proc
'The next two procedures highlight (and lowlight?) the SHIFT & ALT keys.
Procedure SHIFTS[TYPE]
   If TYPE=0
      Ink 6
   Else
      Ink 3
   End If
   ' ----- two shift keys -----
   Bar X Screen(1,134),Y Screen(1,199) To X Screen(1,152),Y Screen(1,209)
   Bar X Screen(1,305),Y Screen(1,199) To X Screen(1,337),Y Screen(1,209)
   ' ----- caps lock -----
   Bar X Screen(1,150),Y Screen(1,185) To X Screen(1,159),Y Screen(1,195)
End Proc
Procedure ALT[TYPE]
   If TYPE=0
      Ink 6
   Else
      Ink 3
   End If
   Bar X Screen(1,143),Y Screen(1,213) To X Screen(1,155),Y Screen(1,223)
   Bar X Screen(1,314),Y Screen(1,213) To X Screen(1,326),Y Screen(1,223)
End Proc
'Procedure to save the keyboard layout stored in memory
Procedure KEYBOARD_SAVE[TYPE]
   Shared FILE$,KEY_BUFFER,LINE$(),BUTTON$()
   On Error Goto FATEL_ERROR1
   If(TYPE=1 and Asc(FILE$)=0) or TYPE=2
      FILE$=Fsel$("*.Key","","Please choose a save name")
   End If
   Bsave FILE$,KEY_BUFFER To KEY_BUFFER+388
   RECOVER_1:
   Pop Proc
   FATEL_ERROR1:
   If FILE$<>""
      For LOP=1 To 5
         Bell 30-LOP
         Wait 3
      Next LOP
      LINE$(0)="Woops, disc error!"
      BUTTON$(0)="Never mind."
      ALERT[21,7,7,1,1,1]
   End If
   Resume RECOVER_1
End Proc
'Procedure to load a Keyboard layout in from disc
Procedure KEYBOARD_LOAD
   Shared FILE$,KEY_BUFFER,LINE$(),BUTTON$()
   On Error Goto FATEL_ERROR2
   FILE$=Fsel$("*.Key","","Please choose a keyboard to load")
   If Not Exist(FILE$)
      For LOP=1 To 5
         Bell 30-LOP
         Wait 3
      Next LOP
      LINE$(0)="I cannot find that"
      LINE$(1)="file on this disc!"
      BUTTON$(0)="Woops........"
      ALERT[21,7,7,1,1,2]
      FILE$=""
   Else
      Open In 1,FILE$
      L=Lof(1)
      Close
      If L<>388
         For LOP=1 To 5
            Bell 30-LOP
            Wait 3
         Next LOP
         LINE$(0)="Hey,  this is not"
         LINE$(1)="an AMOS keytable!"
         BUTTON$(0)="Sorry......"
         ALERT[23,7,7,1,1,2]
         FILE$=""
      Else
         Bload FILE$,KEY_BUFFER
         KEYBOARD_PRINT
      End If
   End If
   RECOVER_2:
   Close
   Pop Proc
   FATEL_ERROR2:
   If FILE$<>""
      For LOP=1 To 5
         Bell 30-LOP
         Wait 3
      Next LOP
      LINE$(0)="Woops, disc error!"
      BUTTON$(0)="Never mind."
      ALERT[21,7,7,1,1,1]
      FILE$=""
   End If
   Resume RECOVER_2
End Proc
'This procedure unpacks a hires screen containing the keyboard picture.
'It also sets up the menu, selected by clicking on the right button!!!
Procedure SET_UP_SCREEN
   Unpack 5 To 1
   Autoback 0
   Paper 0
   Pen 0
   Curs Off
   Print At(0,0);" ";
   Paper 6
   Ink 3
   Menu$(1)=" AMOS  "
   Menu$(1,1)=" About "
   Menu$(1,2)="=======" : Menu Inactive(1,2)
   Menu$(1,3)=" Quit  "
   Menu$(2)=" Edit "
   Menu$(2,1)=" Load Keymap      "
   Menu$(2,2)=" Save Keymap      "
   Menu$(2,3)=" Save As....      "
   Menu$(2,4)="==================" : Menu Inactive(2,4)
   Menu$(2,5)=" Restore Key      "
   Menu$(2,6)=" Restore Keyboard "
   Menu$(2,7)="==================" : Menu Inactive(2,7)
   Menu$(2,8)=" Try Keyboard     "
   Menu On
   Set Font 1
End Proc
'This procedure sets up a zone for nearly EVERY key on the keyboard.
'All of the co-ordinates in the data statements are in HARDWARE format.
Procedure SET_UP_ZONES
   Shared WHERE()
   Reserve Zone(100)
   Restore AREA_DATA
   For LOP=1 To 96
      Read XS,YS,XE,YE
      Set Zone LOP,X Screen(1,XS),Y Screen(1,YS) To X Screen(1,XE),Y Screen(1,YE)
      WHERE(LOP-1,0)=X Screen(1,XS)
      WHERE(LOP-1,1)=Y Screen(1,YS)
      WHERE(LOP-1,2)=X Screen(1,XE)
      WHERE(LOP-1,3)=Y Screen(1,YE)
   Next LOP
   AREA_DATA:
   Data 133,156,149,168
   ' ----- 1234567890-=| ------
   Data 151,156,162,168
   Data 164,156,176,168
   Data 178,156,189,168
   Data 191,156,203,168
   Data 205,156,216,168
   Data 218,156,230,168
   Data 232,156,243,168
   Data 245,156,257,168
   Data 259,156,270,168
   Data 272,156,284,168
   Data 286,156,297,168
   Data 299,156,311,168
   Data 313,156,324,168
   ' ----- ascii char display -----
   Data 288,100,360,114
   ' ----- keypad 0 -----
   Data 391,212,416,224
   ' ----- qwertyuiop[] -----
   Data 157,170,168,182
   Data 170,170,182,182
   Data 184,170,195,182
   Data 197,170,209,182
   Data 211,170,222,182
   Data 224,170,236,182
   Data 238,170,249,182
   Data 251,170,263,182
   Data 265,170,276,182
   Data 278,170,290,182
   Data 292,170,303,182
   Data 305,170,317,182
   ' ----- input window -----
   Data 129,78,447,92
   ' ----- keypad 123 -----
   Data 391,198,403,210
   Data 405,198,416,210
   Data 418,198,430,210
   ' ----- asdfghjkl;# -----
   Data 163,184,174,196
   Data 176,184,188,196
   Data 190,184,201,196
   Data 203,184,215,196
   Data 217,184,228,196
   Data 230,184,242,196
   Data 244,184,255,196
   Data 257,184,269,196
   Data 271,184,282,196
   Data 284,184,296,196
   Data 298,184,309,196
   ' ----- non-English extra key #1 -----
   Data 311,184,323,196
   ' ----- blank #1 -----
   Data 0,0,1,1
   ' ----- keypad 456 ------
   Data 391,184,403,196
   Data 405,184,416,196
   Data 418,184,430,196
   ' ----- non-English extra key #2 -----
   Data 155,198,167,210
   ' ----- zxcvbnm,./ -----
   Data 169,198,180,210
   Data 182,198,194,210
   Data 196,198,207,210
   Data 209,198,221,210
   Data 223,198,234,210
   Data 236,198,248,210
   Data 250,198,261,210
   Data 263,198,275,210
   Data 277,198,288,210
   Data 290,198,302,210
   ' ----- blank #2 -----
   Data 0,0,1,1
   ' ----- keypad .789 -----
   Data 418,212,430,224
   Data 391,170,403,182
   Data 405,170,416,182
   Data 418,170,430,182
   ' ----- space bar -----
   Data 175,212,294,224
   ' ----- caps lock -----
   Data 149,184,160,196
   ' ----- tab key -----
   Data 133,170,155,182
   ' ----- keypad enter -----
   Data 431,198,443,224
   ' ----- left, right shift -----
   Data 133,198,153,210
   Data 304,198,338,210
   ' ----- del key -----
   Data 345,156,364,168
   ' ----- left,right alt -----
   Data 142,212,156,224
   Data 313,212,327,224
   ' ----- dec ascii arrow -----
   Data 206,101,213,113
   ' ----- keypad - -----
   Data 432,170,443,182
   ' ----- inc ascii arrow -----
   Data 362,101,369,113
   ' ----- up,down,right,left cursor keys -----
   Data 359,184,370,196
   Data 359,198,370,210
   Data 372,198,384,210
   Data 345,198,357,210
   ' ----- function keys 1-10 -----
   Data 151,137,166,149
   Data 168,137,183,149
   Data 185,137,200,149
   Data 202,137,217,149
   Data 219,137,234,149
   Data 241,137,256,149
   Data 258,137,273,149
   Data 275,137,290,149
   Data 292,137,307,149
   Data 309,137,324,149
   ' ----- keypad ()/*+ -----
   Data 391,156,403,168
   Data 405,156,416,168
   Data 418,156,430,168
   Data 432,156,443,168
   Data 432,184,443,196
   ' ----- help key -----
   Data 365,156,384,168
End Proc
'This procedure prints out all of the letters on the keyboard.
Procedure KEYBOARD_PRINT
   Shared WHERE(),KEY_BUFFER,WEIGHTING
   Ink 0
   Paper 6
   Set Text 2
   For LOP=0 To 95
      If WHERE(LOP,0)<>0 and LOP<>65 and LOP<>68 and LOP<>69 and LOP<>71 and LOP<>72 and LOP<>73 and LOP<>75 and LOP<>14 and LOP<>28
         KEY_STICK[LOP,0]
      End If
   Next LOP
End Proc
'This procedure just sticks a single letter on the keyboard.
Procedure KEY_STICK[NUM,TYPE]
   Shared WHERE(),KEY_BUFFER,WEIGHTING,XS,XE,YS,YE
   If TYPE=0
      Ink 6
   Else
      Ink 3
   End If
   Gr Writing 0
   XS=WHERE(NUM,0)
   YS=WHERE(NUM,1)
   XE=WHERE(NUM,2)
   YE=WHERE(NUM,3)
   If XS>0 and YS>0
      Bar XS+2,YS+1 To XE-2,YE-1
      X=((XE-XS)/2)+XS-4
      Ink 0
      TEMP=Peek(KEY_BUFFER+NUM+(96*WEIGHTING))
      Text X-1,YE-3,Chr$(TEMP)
   End If
End Proc
'This procedure displays the info about the current ASCII character
'selected.
Procedure DISPLAY_CHAR_VALUE
   Shared SEL_ASCII
   Ink 6
   Bar X Screen(1,217),Y Screen(1,101) To X Screen(1,285),Y Screen(1,113)
   Bar X Screen(1,289),Y Screen(1,101) To X Screen(1,358),Y Screen(1,113)
   Ink 0
   Gr Writing 0
   TEMP1$="ASCII:"+Str$(SEL_ASCII)
   TEMP2$="CHARACTER: "+Chr$(SEL_ASCII)
   X1=(68-Text Length(TEMP1$))/2
   X2=(68-Text Length(TEMP2$))/2
   Text 178+X1,60,TEMP1$
   Text 322+X2,60,TEMP2$
End Proc
'This procedure displays information about the current highlighted key.
Procedure DISPLAY_KEY_INFO[CHAR]
   Shared KEY_BUFFER,WEIGHTING
   TEMP=Peek(KEY_BUFFER+CHAR+(96*WEIGHTING))
   TEMP2=Peek(Start(6)+CHAR+(96*WEIGHTING))
   Ink 6
   Bar 2,29 To 637,41
   Ink 0
   Gr Writing 0
   TEMP1$="KEY SCANCODE:"+Str$(CHAR)+"     "
   TEMP2$="DEFAULT VALUE:"+Str$(TEMP2)+"     "
   TEMP3$="CURRENT VALUE:"+Str$(TEMP)
   X=636-Text Length(TEMP1$+TEMP2$+TEMP3$)
   X=X/2
   Text X,38,TEMP1$+TEMP2$+TEMP3$
End Proc
'You can test the new keys with this procedure!!!
Procedure TEST_KEYBOARD
   Shared HIGHLIGHTED_KEY
   Menu Off
   Ink 6
   Bar X Screen(1,130),Y Screen(1,79) To X Screen(1,446),Y Screen(1,91)
   CUSTOM_INPUT[77,1,4,0,0,6,1,255,True]
   Bar X Screen(1,130),Y Screen(1,79) To X Screen(1,446),Y Screen(1,91)
   If HIGHLIGHTED_KEY<>-1
      DISPLAY_KEY_INFO[HIGHLIGHTED_KEY]
   End If
   Menu On
End Proc
'This procedure is for customised input.
'INPSIZE- the size of the input string (no more than screen length!!)
'X,Y- the x,y position of the text
'TCOL- colour register of text
'CURSCOL- colour register of cursor
'PAPCOL- colour register of paper
'SKEY,EKEY- ASCII values of legal input keys (start to end)
'RID- if true erases the string from screen when input
Procedure CUSTOM_INPUT[INPSIZE,X,Y,TCOL,CURSCOL,PAPCOL,SKEY,EKEY,RID]
   INP$=""
   COUNT=0
   SCANPRESS=0
   X2=X
   Paper PAPCOL
   Print At(X,Y);Space$(INPSIZE+1);
   '   Print At(X-2,Y);"[";At(X+INPSIZE+1,Y);"]"
   Clear Key
   Repeat
      Locate X2,Y
      Pen CURSCOL : Print "_" : Pen TCOL
      Locate X2,Y
      Repeat
         KEY_GET
         PRESSKEY$=Param$
         SCANPRESS=Scancode
      Until(Asc(PRESSKEY$)>=SKEY and Asc(PRESSKEY$)<=EKEY) or SCANPRESS=65 or SCANPRESS=68
      ' If SCANPRESS<>65 and COUNT>0 and SCANPRESS<>68 Then PRESSKEY$=Lower$(PRESSKEY$)
      If SCANPRESS<>65 and COUNT<INPSIZE and SCANPRESS<>68
         Print PRESSKEY$
         INP$=INP$+PRESSKEY$
         Inc COUNT
         Inc X2
      End If
      If SCANPRESS=65 and X2>X and SCANPRESS<>68
         Dec COUNT
         Dec X2
         Locate X2,Y
         Print "  ";
         INP$=Left$(INP$,COUNT)
      End If
   Until SCANPRESS=68
   Print At(X2,Y);" "
   Clear Key
   If RID
      Print At(X,Y);Space$(INPSIZE+2);
   End If
End Proc[INP$]
'This procedure just waits for a key and passes its value back to the
'custom input procedure.
Procedure KEY_GET
   Repeat
      PRESSKEY$=Inkey$
   Until PRESSKEY$<>""
End Proc[PRESSKEY$]
'Aaron Fothergill's (slightly altered to work in hires) Alert Box
'(Uses ZONE's 11+ and returns the button number as a PARAM)
Procedure ALERT[W,H,BACK_COL,LINE_COL,NB,NL]
   Shared LINE$(),BUTTON$()
   Menu Off
   TEMP=0
   W=W*8
   H=H*8
   X=(Screen Width/2)-W/2
   Y=4
   Get Block 241,0,Y-2,Screen Width,H+6
   Ink BACK_COL
   Bar X,Y-2 To X+W,Y+H
   Ink LINE_COL
   Box X+1,Y-2 To X+W-1,Y+H-1
   S=W/8/(NB+1)+1
   Paper BACK_COL
   Pen LINE_COL
   For LOP=0 To NL
      Locate 0,Y Text(Y)+1+LOP
      Centre LINE$(LOP)
   Next LOP
   TEMP=0
   While TEMP<>NB
      Locate X Text(X)+S/2+S*TEMP,Y Text(Y+H)-2
      Print Border$(Zone$(BUTTON$(TEMP),TEMP+97),2);
      Inc TEMP
   Wend
   TEMP=0
   Repeat
      Repeat : Until Mouse Click and Mouse Key=1
      TEMP=Mouse Zone
   Until TEMP>96
   Put Block 241,0,Y-2
   Del Block 241
   Add TEMP,-96
   For LOP=0 To NB
      BUTTON$(LOP)=""
   Next LOP
   For LOP=0 To NL
      LINE$(LOP)=""
   Next LOP
   Menu On
End Proc[TEMP]